### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ###
##  This program creates the figures for the business cycle paper.   ##
##  v2 uses updated figures_main charting functions.                 ##
##                                                                   ##
## Author: Sarah Friedman                                            ##
## Date: December 2019                                               ##
## Update: April 2021 (SEF)                                          ##
### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ###


# Preliminaries -----------------------------------------------------------

rm(list=ls())

# Set directories ---------------------------------------------------------

home_directory = "[your home directory]" # change this to your home directory
master_scripts_directory <- file.path(home_directory, "/Figures/Non_IRF_Figures") # where the program sources DFA functions for figures
figures_directory <- file.path(home_directory, "/Figures/Non_IRF_Figures/output")

# Load in data ------------------------------------------------------------
library(RColorBrewer)
library(latex2exp)
library(readxl)
library(tidyverse)
source(file.path(master_scripts_directory, "functions.R"))
source(file.path(master_scripts_directory, "dfa_plot_funcs.R"))

### This script gathers the data needed for all of the charts 
source(file.path(master_scripts_directory, "get_businesscycle_data.R"))

buscycle_legtext <- c("Top .1%", "99 - 99.9%", "90 - 99%", "70 - 90%", "50 - 70%", "Bottom 50%")
buscycle_colors <- rev(dfa_colors[1:6])

setcmpar()
style$legend.cex <- 1
style$freq.label.cex <- 1


# Main text figures -------------------------------------------------------


# Figure 1: SCF dot figures ---------------------------------------------------------

postscript(file = file.path(figures_directory, "scf_shares_dots.eps"), width = 4, height = 4)
par(mar = c(2,1,2,2))
pinfo <- dfa_shares_stacked(plotdata = nw_shares_bynw,
                            Col = buscycle_colors,
                            legend = FALSE,
                            Xlim = c(1987.5,2022.75),
                            Y2lim = c(-10,105),
                            Y2at = seq(0,100,10),
                            # label starting and ending shares on graph 
                            Slab_ends = TRUE,
                            Slab_skip = c(1)
)

dev.off()


postscript(file = file.path(figures_directory, "scf_levels_dots.eps"), width = 4, height = 4)
par(mar = c(2,1,2,2))
pinfo <- dfa_levels_stacked(plotdata = nw_levels_bynw,
                            Col = buscycle_colors,
                            legend = FALSE,
                            dots = TRUE,
                            Y2lim = c(-20, 140), Y2at = seq(0,140,20),
                            Xlim = c(1987.5,2022.75)
)
dev.off()

postscript(file = file.path(figures_directory, "scf_dots_legend.eps"), width = 6, height = .6)
par(mar=c(0,0,0,0))
plot(NULL ,xaxt='n',yaxt='n',bty='n',ylab='',xlab='', xlim=0:1, ylim=0:1)
legend("topleft", legend = c(buscycle_legtext, "SCF"), cex=1.25,
       bty='n', fill = c(rev(buscycle_colors), NA), ncol = 4,
       pch = c(rep(NA,6), 20), border = NA)
dev.off()


# Figure 2: total assets by wealth group ----------------------------------


postscript(file = file.path(figures_directory, paste0("levels_assets.eps")), width = 4, height = 4)
par(mar = c(2,1,2,2))
pinfo <- dfa_levels_stacked(plotdata = assets_levels_bynw,
                            Col = buscycle_colors,
                            legend = FALSE,
                            Y2lim = c(-20,160), Y2at = seq(0,160,20),
                            Xlim = c(1987.5,2022.75))
dev.off()


postscript(file = file.path(figures_directory, paste0("shares_assets.eps")), width = 4, height = 4)
par(mar = c(2,1,2,2))
pinfo <- dfa_shares_stacked(plotdata = assets_shares_bynw,
                            Col = buscycle_colors,
                            legend = FALSE,
                            dots = FALSE,
                            Xlim = c(1987.5,2022.75),
                            Y2lim = c(-10,105),
                            Y2at = seq(0,100,10),
                            Slab_ends = TRUE,
                            Slab_skip = c(1)
                            
)
dev.off()

postscript(file = file.path(figures_directory, "stacked_legend.eps"), width = 6, height = .6)
par(mar=c(0,0,0,0))
plot(NULL ,xaxt='n',yaxt='n',bty='n',ylab='',xlab='', xlim=0:1, ylim=0:1)
legend("topleft", legend = buscycle_legtext, cex=1.25,
       bty='n', fill = rev(buscycle_colors), ncol = 3, border = NA)
dev.off()


# Figure 3: total liabilities by wealth group ----------------------------------

postscript(file = file.path(figures_directory, paste0("levels_liab.eps")), width = 4, height = 4)
par(mar = c(2,1,2,2))
pinfo <- dfa_levels_stacked(plotdata = liab_levels_bynw,
                            Col = buscycle_colors,
                            legend = FALSE,
                            Xlim = c(1987.5,2022.75),
                            Y2lim = c(-2,17), Y2at = seq(0,16,2)
)
dev.off()

postscript(file = file.path(figures_directory, paste0("shares_liab.eps")), width = 4, height = 4)
par(mar = c(2,1,2,2))
pinfo <- dfa_shares_stacked(plotdata = liab_shares_bynw,
                            Col = buscycle_colors,
                            legend = FALSE,
                            Xlim = c(1987.5,2022.75),
                            Y2lim = c(-10,105),
                            Y2at = seq(0,100,10),
                            Slab_ends = TRUE,
                            Slab_skip = c(6)
)
dev.off()

# Figure 4a: business equity as a share of total wealth ------------------------------

style$footnote.cex <- .65

postscript(file = file.path(figures_directory, "buseq_share.eps"), width = 4, height = 4)
par(mar = c(3, 1, 2, 2))
rplot.line(
  plotdata = buseq_shareofnw,
  # Title = "Total business equity as share of total wealth", 
  NBER = TRUE,
  Slabvec = paste0(c(round(first(buseq_shareofnw$buseq)), round(last(buseq_shareofnw$buseq))), "%"),
  Slabloc.x = c(1990, 2020.25),
  Slabloc.y = c(round(first(buseq_shareofnw$buseq)) + .25, round(last(buseq_shareofnw$buseq)) + .25),
  Slabadj = c(.5, 0),
  footvec = "Note: Business equity is the sum of corporate equities and mutual fund shares plus equity in noncorporate business.",
  Y2lab = "Percent",
  Lwd = 2,
  Enddatelab = FALSE,
  shading.border = FALSE
)
dev.off()


# Figure 4b: Top 1%'s share of total business equity ---------------------------------

postscript(file = file.path(figures_directory, "top1_buseq_share.eps"), width = 4, height = 4)
par(mar = c(3, 1, 2, 2))
rplot.line(
  plotdata = top1_shareofbuseq,
  Col = dfa_colors[1],
  # Title = "Top 1%'s share of total business equity", 
  NBER = TRUE,
  Slabvec = paste0(c(round(first(top1_shareofbuseq$top1_shareofbuseq)), round(last(top1_shareofbuseq$top1_shareofbuseq))), "%"),
  Slabloc.x = c(1990, 2020.25),
  Slabloc.y = c(round(first(top1_shareofbuseq$top1_shareofbuseq)) + .25, round(last(top1_shareofbuseq$top1_shareofbuseq))),
  Slabadj = c(.5, 0),
  Y2lab = "Percent",
  Lwd = 2,
  Enddatelab = FALSE,
  shading.border = FALSE
)
dev.off()

# Figure 5a: Real estate equity as share of total wealth -----------------------------

postscript(file = file.path(figures_directory, "realestate_share.eps"), width = 4, height = 4)
par(mar = c(2, 1, 1, 2))
rplot.line(
  plotdata = realestate_shareofnw,
  # Title = "Total business equity as share of total wealth", 
  NBER = TRUE,
  Slabvec = paste0(c(round(first(realestate_shareofnw$realestate)), round(last(realestate_shareofnw$realestate))), "%"),
  Slabloc.x = c(1990, 2020.25),
  Slabloc.y = c(round(first(realestate_shareofnw$realestate)) + .25, round(last(realestate_shareofnw$realestate)) + 0.8),
  Slabadj = c(.5, 0),
  footvec = "Note: Real estate equity is defined as real estate less mortgages..",
  Y2lab = "Percent",
  Lwd = 2,
  Enddatelab = FALSE,
  shading.border = FALSE
)
dev.off()


# Figure 5b: 50 - 90 percentile's share of total real estate equity ----------------------------

postscript(file = file.path(figures_directory, "pct50to90_realestate_share.eps"), width = 4, height = 4)
par(mar = c(2, 1, 1, 2))
rplot.line(
  plotdata = pct50to90_shareofrealestate,
  Col = dfa_colors[3],
  NBER = TRUE,
  Slabvec = paste0(c(round(first(pct50to90_shareofrealestate$pct50to90_shareofrealestate)), round(last(pct50to90_shareofrealestate$pct50to90_shareofrealestate))), "%"),
  Slabloc.x = c(1989.9, 2020.25),
  Slabloc.y = c(round(first(pct50to90_shareofrealestate$pct50to90_shareofrealestate)) - 1, round(last(pct50to90_shareofrealestate$pct50to90_shareofrealestate)) - 0.5),
  Slabadj = c(.5, 0),
  Y2lab = "Percent",
  Lwd = 2,
  Enddatelab = FALSE,
  shading.border = FALSE
)
dev.off()

# Figure 6: Bottom 50% balance sheet ------------------------------------------------


postscript(file = file.path(figures_directory, "bottom50_bs.eps"), width = 4, height = 4)
par(mar = c(2, 1, 1, 2))
rplot.line(
  plotdata = bottom50_assets,
  stack.line = TRUE,
  Y2lab = "Trillions of dollars",
  Enddatelab = FALSE,
  Col = c("#4D4D4D", "#8E8E8E"), #c("dodgerblue3", "aquamarine3"),
  Y2lim = c(-7,10),
  Y2int = 2,
  Zeroline = TRUE
)
par(mar = c(2, 1, 1, 2), new = TRUE)
rplot.line(
  plotdata = bottom50_liab,
  stack.line = TRUE,
  Enddatelab = FALSE,
  Col = c("#BDBDBD", "#D7D7D7"),#c("deeppink2", "coral1"),
  Y2lim = c(-7,10),
  Y2int = 2,
  Zeroline = TRUE
)
par(mar = c(2, 1, 1, 2), new = TRUE)
rplot.line(
  plotdata = bottom50_nw,
  Enddatelab = FALSE,
  Y2lim = c(-7,10),
  Y2int = 2,
  Zeroline = TRUE,
  Lwd = 2
)
legend(x = "topleft", 
       legend = c("Other assets", "Real estate", "Mortgages", "Other liabilities", "Net worth"),
       fill = c("#8E8E8E", "#4D4D4D", "#BDBDBD", "#D7D7D7", NA),#c("aquamarine3", "dodgerblue3", "deeppink2", "coral1", NA),
       border = c("#8E8E8E", "#4D4D4D", "#BDBDBD", "#D7D7D7", NA),#c("aquamarine3", "dodgerblue3", "deeppink2", "coral1", NA),
       bty = "n",
       cex = .7,
       merge = TRUE,
       lty = c(rep(NA,4), "solid"),
       col = c("#8E8E8E", "#4D4D4D", "#BDBDBD", "#D7D7D7", "black"),#c("aquamarine3", "dodgerblue3", "deeppink2", "coral1", "black"),
       inset = .035,
       xjust = 0
)

dev.off()


# Figure 7: Out of sample Comparison to 2007-2009 SCF Panel -----------------------------------------------------------

# DFA data for figure 7, please see panel_assets_debt_for_replication.do for SCF output

for (gr in names(out_of_sample)) {
  
  plotdata <- out_of_sample[[gr]]
  
  postscript(file = file.path(figures_directory, paste0("out_of_sample_panel_", tolower(gr), ".eps")), width = 4, height = 4)
  
  par(mar = c(1.5,0,1,1), mgp = c(3,.1,0))
  
  pinfo <- dfa_balance_sheet(plotdata = plotdata,
                             legend = FALSE,
                             xaxis.label = c("2007Q3", "2009Q3", "2009Q3\nSCF Panel"))
  
  dev.off()
  
}

postscript(file = file.path(figures_directory, "balancesheet_legend.eps"), width = 7, height = .6)
par(mar=c(0,0,0,0))
plot(NULL ,xaxt='n',yaxt='n',bty='n',ylab='',xlab='', xlim=0:1, ylim=0:1)
legend("topleft", legend = c("Other Financial Assets", "Nonfinancial Assets", "Business Equity", "Other Liabilities",  "Mortgages", "Net worth"),
       cex=1.25,
       bty='n', 
       pch = c(rep(NA,5), 20),
       fill = c("#4D4D4D", "#7D7D7D", "#9D9D9D", "#BDBDBD", "#CDCDCD", NA),#c("steelblue4", "lightskyblue2", "palegreen3", "red3" ,"indianred1", NA), 
       ncol = 3, border = NA)
dev.off()



# Figure 8: Cyclical variation in wealth -----------------------------------------------------------------

dfa_cyclical_var <- function(plot.data, col, legendtext, y2.lim, y2.int) {
  par(mar = c(2,1,2,2))
  pinfo <- rplot.line(
    plotdata = plot.data,
    Col = col,
    legend = TRUE,
    legend.text = legendtext,
    legend.text.col = "black",
    legend.x.loc = 1990,
    legend.x.just = 0,
    Lty = c(1, 2),
    Lwd = c(2, 2),
    legend.lty = c(1,2),
    legend.lwd = c(2,2),
    Y2lab = "Percentage points",
    NBER = TRUE,
    shading.border = FALSE,
    Enddatelab = FALSE,
    Y2lim = c(-.5,.6),
    Y2int = .1,
    Zeroline = TRUE,
    Freqlab2 = "4-quarter moving average"
  )
  
}

postscript(file = file.path(figures_directory, "nw_diff_full_top.eps"), width = 4, height = 4)
par(mar = c(2,1,2,2))
dfa_cyclical_var(
  plot.data = dfa_share_change %>% select(date, TopPt1, pct99to999),
  col =  buscycle_colors[6:5],
  legendtext =  c("Top .1%", "99 to 99.9%")

)
dev.off()

postscript(file = file.path(figures_directory, "nw_diff_full_middle.eps"), width = 4, height = 4)
dfa_cyclical_var(
  plot.data =  dfa_share_change %>% select(date, pct90to99, pct70to90),
  col = buscycle_colors[6:5],
  legendtext = c("90 - 99%", "70 - 90%")
  
)
dev.off()

postscript(file = file.path(figures_directory, "nw_diff_full_bottom.eps"), width = 4, height = 4)
dfa_cyclical_var(
  plot.data = dfa_share_change %>% select(date, pct50to70, Bottom50),
  col =  buscycle_colors[6:5],
  legendtext = c("50 - 70%", "Bottom 50%")
)
dev.off()

# Figure 9: portfolio shares (normalized) ---------------------------------------------

# portfolio compositions rescaled so that total assets equal to one) of our four wealth groups averaged over all quarters

postscript(file = file.path(figures_directory, "balance_shares_norm.eps"), width = 7, height = 5)
par(mar = c(1.5,0,1,1), mgp = c(3,.1,0))
pinfo <- dfa_balance_sheet(
  plotdata = dfa_balance_share_norm,
  networth.dots = FALSE,
  legend.text = c("Other Financial Assets", "Nonfinancial Assets", "Business Equity", "Other Liabilities", "Mortgages"),
  xaxis.label = c("Top .1%", "99 - 99.9%", "90 - 99%", "70 - 90%", "50 - 70%", "Bottom 50%"),
  space = .25,
  legend.cex = .8,
  legend.ncol = 3
  
)
dev.off()


# Figure 10: Decomposition ------------------------------------------------

style$cm.cex <- 1
style$legend.cex <- 1.5
style$freq.label.cex <- 1.5
style$y2.scale.cex <- 1.5
style$date.label.cex <- 1.5
style$xticks.label.cex <- 1.5
style$yticks.label.cex <- 1.5
style$x.mgp[2] <- 1 # default is .1 
style$y.mgp[2] <- 2 # default is 1
style$freq.line <- -2

for (gr in unique(decomp$cat)) {
  
  decomp_gr <- decomp_ma %>% 
    ungroup() %>% 
    filter(cat == gr) %>% 
    select(-cat, -networth_p) %>% 
    drop_na() %>% 
    mutate(date = as.Date(date, frac=1))
  
  if (gr == "Bottom50") {
    y2lim <- NULL
    y2at <- NULL
  } else {
    y2lim <- c(-.08,.08)
    y2at <- seq(-.08,.08,.02)
  }
  
  postscript(file.path(figures_directory, paste0(gr, "_decomp.eps")))
  par(mar = c(3,1,2,5))
  rplot.line(
    plotdata = decomp_gr,
    Enddatelab = FALSE,
    Col = dfa_colors[c(1,3,7)],
    Lwd = 1.5,
    legend = TRUE,
    legend.text = c("E", "U", TeX(r'($Y^{NW,p}_{t} / Y^{NW,p}_{t-1} - 1$)')),
    legend.x.loc = "topleft",
    legend.inset = c(.03,.03),
    legend.text.col = "black",
    NBER = TRUE,
    Freqlab2 = "4-quarter moving average",
    Y2lab = "",
    Y2lim = y2lim, 
    Y2at = y2at,
    shading.border = FALSE,
    Zeroline = TRUE
  )
  dev.off()
  
}

# Figure 11: Counterfactual shares ---------------------------------------------------


grnames <- dfa_splits(group = "networth", agg_level = "bus_cycle2")$groupnames

for (gr in grnames) {
  
  df <- share_diff_counterfactual_ma %>% 
    select(date, contains(gr))
  
  postscript(file.path(figures_directory, paste0("share_counterfactuals_", gr, ".eps" )))
  par(mar = c(3,1,2,5))
  rplot.line(
    plotdata = df, 
    Col = c("#4D4D4D", "black", "#737373"),#c("black", "blue", "red"),
    Lty = c("solid", "dashed", "twodash"),
    Lwd = 1.5,
    Enddatelab = FALSE,
    legend = TRUE,
    legend.col = c("#4D4D4D", "black", "#737373"),#c("black", "blue", "red"),
    legend.lty = c("solid", "dashed", "twodash"),
    legend.lwd = 2,
    legend.text = c("Baseline", "No Price Changes", "No Group Changes"),
    legend.text.col = "black",
    legend.x.loc = "topleft",
    legend.inset = c(.03,.03),
    NBER = TRUE,
    shading.border = FALSE,
    Y2lim = c(-.005,.005),
    Y2at = seq(-.005,.005,.001),
    Zeroline = TRUE
  )
  dev.off()
}


